home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
lsp
/
assert.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
16KB
|
714 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "assert.h"
init_assert(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
base[0]= VV[0];
(void)simple_symlispcall_no_event(VV[57],base+0,1);
MM(VV[58],L2,start,size,data);
MM(VV[59],L3,start,size,data);
MF(VV[60],L4,start,size,data);
MM(VV[61],L5,start,size,data);
MM(VV[62],L6,start,size,data);
MM(VV[63],L7,start,size,data);
MM(VV[64],L8,start,size,data);
MM(VV[65],L9,start,size,data);
MF(VV[36],L10,start,size,data);
MF(VV[66],L11,start,size,data);
MF(VV[67],L12,start,size,data);
vs_top=vs_base=base;
}
/* macro definition for CHECK-TYPE */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(2);
vs_top=sup;
{object V1=base[0]->c.c_cdr;
if(endp(V1))invalid_macro_call();
base[2]= (V1->c.c_car);
V1=V1->c.c_cdr;
if(endp(V1))invalid_macro_call();
base[3]= (V1->c.c_car);
V1=V1->c.c_cdr;
if(endp(V1)){
base[4]= Cnil;
base[5]= Cnil;
} else {
base[4]= (V1->c.c_car);
base[5]= Ct;
V1=V1->c.c_cdr;}
if(!endp(V1))invalid_macro_call();}
base[6]= list(2,VV[4],base[3]);
base[7]= list(3,VV[3],base[2],base[6]);
base[8]= list(2,base[7],Cnil);
base[9]= list(2,VV[4],base[2]);
if((base[5])==Cnil){
goto T6;}
base[10]= base[4];
goto T4;
T6:;
base[10]= list(2,VV[4],base[3]);
T4:;
base[11]= list(6,VV[5],VV[6],VV[7],base[9],base[2],base[10]);
base[13]= base[2];
vs_top=(vs_base=base+13)+1;
L4();
vs_top=sup;
base[12]= vs_base[0];
base[13]= list(6,VV[1],VV[2],base[8],base[11],base[12],VV[8]);
vs_top=(vs_base=base+13)+1;
return;
}
/* macro definition for ASSERT */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(2);
vs_top=sup;
{object V2=base[0]->c.c_cdr;
if(endp(V2))invalid_macro_call();
base[2]= (V2->c.c_car);
V2=V2->c.c_cdr;
if(endp(V2)){
base[3]= Cnil;
} else {
base[3]= (V2->c.c_car);
V2=V2->c.c_cdr;}
if(endp(V2)){
base[4]= Cnil;
} else {
base[4]= (V2->c.c_car);
V2=V2->c.c_cdr;}
base[5]= V2;}
base[6]= list(2,base[2],Cnil);
if((base[4])==Cnil){
goto T14;}
base[7]= listA(4,VV[5],VV[10],base[4],base[5]);
goto T12;
T14:;
base[8]= list(2,VV[4],base[2]);
base[7]= list(4,VV[5],VV[11],VV[12],base[8]);
T12:;
{object V3;
object V4= base[3];
if(endp(V4)){
base[8]= Cnil;
goto T16;}
base[9]=V3=MMcons(Cnil,Cnil);
T17:;
base[10]= (V4->c.c_car);
vs_top=(vs_base=base+10)+1;
L4();
vs_top=sup;
(V3->c.c_car)= vs_base[0];
if(endp(V4=MMcdr(V4))){
base[8]= base[9];
goto T16;}
V3=MMcdr(V3)=MMcons(Cnil,Cnil);
goto T17;}
T16:;
base[9]= append(base[8],VV[13]);
base[10]= listA(5,VV[1],VV[9],base[6],base[7],base[9]);
vs_top=(vs_base=base+10)+1;
return;
}
/* function definition for ASK-FOR-FORM */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= list(2,VV[4],base[0]);
base[2]= list(4,VV[15],VV[16],VV[17],base[1]);
base[3]= list(3,VV[19],base[0],VV[20]);
base[4]= list(4,VV[14],base[2],VV[18],base[3]);
vs_top=(vs_base=base+4)+1;
return;
}
/* macro definition for ECASE */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
check_arg(2);
vs_top=sup;
{object V5=base[0]->c.c_cdr;
if(endp(V5))invalid_macro_call();
base[2]= (V5->c.c_car);
V5=V5->c.c_cdr;
base[3]= V5;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[4]= vs_base[0];}
base[5]= reverse(base[3]);
base[7]= list(2,VV[4],base[2]);
{object V6;
object V7= base[3];
if(endp(V7)){
base[8]= Cnil;
goto T23;}
base[9]=V6=MMcons(Cnil,Cnil);
T24:;
if(!(type_of(car((V7->c.c_car)))==t_cons||car((V7->c.c_car))==Cnil)){
goto T27;}
{object V8;
object V9= car((V7->c.c_car));
if(endp(V9)){
(V6->c.c_cdr)= Cnil;
goto T25;}
base[11]=V8=MMcons(Cnil,Cnil);
T29:;
(V8->c.c_car)= list(2,VV[4],(V9->c.c_car));
if(endp(V9=MMcdr(V9))){
(V6->c.c_cdr)= base[11];
goto T25;}
V8=MMcdr(V8)=MMcons(Cnil,Cnil);
goto T29;}
T27:;
base[11]= list(2,VV[4],car((V7->c.c_car)));
(V6->c.c_cdr)= make_cons(base[11],Cnil);
T25:;
while(!endp(MMcdr(V6)))V6=MMcdr(V6);
if(endp(V7=MMcdr(V7))){
base[9]=base[9]->c.c_cdr;
base[8]= base[9];
goto T23;}
goto T24;}
T23:;
base[9]= listA(5,VV[23],VV[24],base[7],base[4],base[8]);
base[6]= list(3,VV[21],VV[22],base[9]);
T32:;
if(!(endp(base[5]))){
goto T33;}
base[7]= list(2,base[4],base[2]);
base[8]= make_cons(base[7],Cnil);
base[9]= list(3,VV[21],base[8],base[6]);
vs_top=(vs_base=base+9)+1;
return;
T33:;
if((caar(base[5]))==Cnil){
goto T37;}
if(!(type_of(caar(base[5]))==t_cons||caar(base[5])==Cnil)){
goto T43;}
base[8]= list(2,VV[4],caar(base[5]));
base[7]= list(3,VV[26],base[4],base[8]);
goto T41;
T43:;
base[8]= list(2,VV[4],caar(base[5]));
base[7]= list(3,VV[27],base[4],base[8]);
T41:;
base[8]= make_cons(VV[14],cdar(base[5]));
base[6]= list(4,VV[25],base[7],base[8],base[6]);
T37:;
base[5]= cdr(base[5]);
goto T32;
}
/* macro definition for CCASE */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
check_arg(2);
vs_top=sup;
{object V10=base[0]->c.c_cdr;
if(endp(V10))invalid_macro_call();
base[2]= (V10->c.c_car);
V10=V10->c.c_cdr;
base[3]= V10;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[4]= vs_base[0];}
base[5]= list(2,base[4],base[2]);
base[6]= make_cons(base[5],Cnil);
{object V11;
object V12= base[3];
if(endp(V12)){
base[7]= Cnil;
goto T49;}
base[8]=V11=MMcons(Cnil,Cnil);
T50:;
if(!(type_of(car((V12->c.c_car)))==t_cons||car((V12->c.c_car))==Cnil)){
goto T54;}
base[11]= list(2,VV[4],car((V12->c.c_car)));
base[10]= list(3,VV[26],base[4],base[11]);
goto T52;
T54:;
base[11]= list(2,VV[4],car((V12->c.c_car)));
base[10]= list(3,VV[27],base[4],base[11]);
T52:;
base[11]= make_cons(VV[14],cdr((V12->c.c_car)));
base[12]= list(2,VV[30],base[11]);
(V11->c.c_car)= list(3,VV[29],base[10],base[12]);
if(endp(V12=MMcdr(V12))){
base[7]= base[8];
goto T49;}
V11=MMcdr(V11)=MMcons(Cnil,Cnil);
goto T50;}
T49:;
base[8]= list(2,VV[4],base[2]);
{object V13;
object V14= base[3];
if(endp(V14)){
base[9]= Cnil;
goto T56;}
base[10]=V13=MMcons(Cnil,Cnil);
T57:;
if(!(type_of(car((V14->c.c_car)))==t_cons||car((V14->c.c_car))==Cnil)){
goto T60;}
{object V15;
object V16= car((V14->c.c_car));
if(endp(V16)){
(V13->c.c_cdr)= Cnil;
goto T58;}
base[12]=V15=MMcons(Cnil,Cnil);
T62:;
(V15->c.c_car)= list(2,VV[4],(V16->c.c_car));
if(endp(V16=MMcdr(V16))){
(V13->c.c_cdr)= base[12];
goto T58;}
V15=MMcdr(V15)=MMcons(Cnil,Cnil);
goto T62;}
T60:;
base[12]= list(2,VV[4],car((V14->c.c_car)));
(V13->c.c_cdr)= make_cons(base[12],Cnil);
T58:;
while(!endp(MMcdr(V13)))V13=MMcdr(V13);
if(endp(V14=MMcdr(V14))){
base[10]=base[10]->c.c_cdr;
base[9]= base[10];
goto T56;}
goto T57;}
T56:;
base[10]= listA(6,VV[5],VV[32],VV[33],base[8],base[4],base[9]);
base[12]= base[2];
vs_top=(vs_base=base+12)+1;
L4();
vs_top=sup;
base[11]= vs_base[0];
base[12]= list(5,VV[21],VV[31],base[10],base[11],VV[34]);
base[13]= make_cons(base[12],Cnil);
base[14]= append(base[7],base[13]);
base[15]= listA(3,VV[21],base[6],base[14]);
base[16]= list(2,VV[28],base[15]);
vs_top=(vs_base=base+16)+1;
return;
}
/* macro definition for TYPECASE */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(2);
vs_top=sup;
{object V17=base[0]->c.c_cdr;
if(endp(V17))invalid_macro_call();
base[2]= (V17->c.c_car);
V17=V17->c.c_cdr;
base[3]= V17;}
base[4]= reverse(base[3]);
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[6]= vs_base[0];
base[5]= Cnil;
T69:;
if(!(endp(base[4]))){
goto T70;}
base[7]= list(2,base[6],base[2]);
base[8]= make_cons(base[7],Cnil);
base[9]= list(3,VV[21],base[8],base[5]);
vs_top=(vs_base=base+9)+1;
return;
T70:;
if(caar(base[4])==Ct){
goto T75;}
if(!(caar(base[4])==VV[35])){
goto T76;}
T75:;
base[5]= make_cons(VV[14],cdar(base[4]));
goto T74;
T76:;
base[7]= list(2,VV[4],caar(base[4]));
base[8]= list(3,VV[3],base[6],base[7]);
base[9]= make_cons(VV[14],cdar(base[4]));
base[5]= list(4,VV[25],base[8],base[9],base[5]);
T74:;
base[4]= cdr(base[4]);
goto T69;
}
/* macro definition for ETYPECASE */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
check_arg(2);
vs_top=sup;
{object V18=base[0]->c.c_cdr;
if(endp(V18))invalid_macro_call();
base[2]= (V18->c.c_car);
V18=V18->c.c_cdr;
base[3]= V18;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[4]= vs_base[0];}
base[7]= list(2,VV[4],base[2]);
{object V19;
object V20= base[3];
if(endp(V20)){
base[8]= Cnil;
goto T87;}
base[9]=V19=MMcons(Cnil,Cnil);
T88:;
(V19->c.c_car)= car((V20->c.c_car));
if(endp(V20=MMcdr(V20))){
base[8]= base[9];
goto T87;}
V19=MMcdr(V19)=MMcons(Cnil,Cnil);
goto T88;}
T87:;
base[9]= list(2,VV[4],base[8]);
base[10]= list(4,VV[36],base[7],base[4],base[9]);
base[6]= list(2,VV[23],base[10]);
base[5]= base[3];
T91:;
if(!(endp(base[5]))){
goto T92;}
base[7]= list(2,base[4],base[2]);
base[8]= make_cons(base[7],Cnil);
base[9]= list(3,VV[21],base[8],base[6]);
vs_top=(vs_base=base+9)+1;
return;
T92:;
base[7]= list(2,VV[4],caar(base[5]));
base[8]= list(3,VV[3],base[4],base[7]);
base[9]= make_cons(VV[14],cdar(base[5]));
base[6]= list(4,VV[25],base[8],base[9],base[6]);
base[5]= cdr(base[5]);
goto T91;
}
/* macro definition for CTYPECASE */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
check_arg(2);
vs_top=sup;
{object V21=base[0]->c.c_cdr;
if(endp(V21))invalid_macro_call();
base[2]= (V21->c.c_car);
V21=V21->c.c_cdr;
base[3]= V21;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[4]= vs_base[0];}
base[5]= list(2,base[4],base[2]);
base[6]= make_cons(base[5],Cnil);
{object V22;
object V23= base[3];
if(endp(V23)){
base[7]= Cnil;
goto T102;}
base[8]=V22=MMcons(Cnil,Cnil);
T103:;
base[10]= list(2,VV[4],car((V23->c.c_car)));
base[11]= list(3,VV[3],base[4],base[10]);
base[12]= make_cons(VV[14],cdr((V23->c.c_car)));
base[13]= list(2,VV[30],base[12]);
(V22->c.c_car)= list(3,VV[29],base[11],base[13]);
if(endp(V23=MMcdr(V23))){
base[7]= base[8];
goto T102;}
V22=MMcdr(V22)=MMcons(Cnil,Cnil);
goto T103;}
T102:;
base[8]= list(2,VV[4],base[2]);
{object V24;
object V25= base[3];
if(endp(V25)){
base[9]= Cnil;
goto T105;}
base[10]=V24=MMcons(Cnil,Cnil);
T106:;
(V24->c.c_car)= car((V25->c.c_car));
if(endp(V25=MMcdr(V25))){
base[9]= base[10];
goto T105;}
V24=MMcdr(V24)=MMcons(Cnil,Cnil);
goto T106;}
T105:;
base[10]= list(2,VV[4],base[9]);
base[11]= list(4,VV[36],base[8],base[4],base[10]);
base[12]= list(3,VV[5],VV[37],base[11]);
base[13]= make_cons(base[12],Cnil);
base[14]= append(base[7],base[13]);
base[15]= listA(3,VV[21],base[6],base[14]);
base[17]= base[2];
vs_top=(vs_base=base+17)+1;
L4();
vs_top=sup;
base[16]= vs_base[0];
base[17]= list(4,VV[28],base[15],base[16],VV[38]);
vs_top=(vs_base=base+17)+1;
return;
}
/* function definition for TYPECASE-ERROR-STRING */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
check_arg(3);
vs_top=sup;
TTL:;
base[3]= Cnil;
base[4]= Cnil;
base[5]= Cnil;
T112:;
if(!(endp(base[2]))){
goto T113;}
goto T110;
T113:;
if(!(type_of(car(base[2]))==t_symbol)){
goto T119;}
base[6]= make_cons(car(base[2]),Cnil);
base[3]= make_cons(base[6],base[3]);
base[6]= car(base[2]);
base[2]= cdr(base[2]);
goto T117;
T119:;
{object V26= caar(base[2]);
if((V26!= VV[68]))goto T126;
base[2]= append(cdar(base[2]),cdr(base[2]));
goto T117;
T126:;
if((V26!= VV[26]))goto T128;
{
object V27= cdar(base[2]);
if(endp(V27)){
goto T129;}
T130:;
base[7]= list(2,VV[26],(V27->c.c_car));
base[3]= make_cons(base[7],base[3]);
if(endp(V27=MMcdr(V27))){
goto T129;}
goto T130;}
T129:;
base[6]= car(base[2]);
base[2]= cdr(base[2]);
goto T117;
T128:;
if((V26!= VV[69]))goto T136;
base[4]= make_cons(cadar(base[2]),base[4]);
base[6]= car(base[2]);
base[2]= cdr(base[2]);
goto T117;
T136:;
base[3]= make_cons(car(base[2]),base[3]);
base[6]= car(base[2]);
base[2]= cdr(base[2]);}
T117:;
goto T112;
T110:;
T151:;
if(!(endp(base[4]))){
goto T152;}
goto T149;
T152:;
if(!(type_of(car(base[4]))==t_symbol)){
goto T158;}
base[6]= make_cons(car(base[4]),Cnil);
base[5]= make_cons(base[6],base[5]);
base[6]= car(base[4]);
base[4]= cdr(base[4]);
goto T156;
T158:;
if(!(caar(base[4])==VV[39])){
goto T166;}
base[4]= append(cdar(base[4]),cdr(base[4]));
goto T156;
T166:;
base[5]= make_cons(car(base[4]),base[5]);
base[6]= car(base[4]);
base[4]= cdr(base[4]);
T156:;
goto T151;
T149:;
base[6]= Cnil;
base[7]= VV[40];
base[8]= base[0];
base[9]= base[1];
base[10]= VV[41];
{object V28;
object V29= base[5];
if(endp(V29)){
base[11]= Cnil;
goto T181;}
base[12]=V28=MMcons(Cnil,Cnil);
T182:;
base[13]= (V29->c.c_car);
vs_top=(vs_base=base+13)+1;
L11();
vs_top=sup;
(V28->c.c_cdr)= vs_base[0];
while(!endp(MMcdr(V28)))V28=MMcdr(V28);
if(endp(V29=MMcdr(V29))){
base[12]=base[12]->c.c_cdr;
base[11]= base[12];
goto T181;}
goto T182;}
T181:;
base[12]= VV[42];
base[14]= make_fixnum(length(base[3]));
base[17]= reverse(base[3]);
{object V30;
object V31= base[17];
if(endp(V31)){
base[15]= Cnil;
goto T187;}
base[16]=V30=MMcons(Cnil,Cnil);
T188:;
base[18]= (V31->c.c_car);
vs_top=(vs_base=base+18)+1;
L11();
vs_top=sup;
(V30->c.c_cdr)= vs_base[0];
while(!endp(MMcdr(V30)))V30=MMcdr(V30);
if(endp(V31=MMcdr(V31))){
base[16]=base[16]->c.c_cdr;
base[15]= base[16];
goto T187;}
goto T188;}
T187:;
base[16]= make_cons(base[14],base[15]);
base[13]= make_cons(base[5],base[16]);
vs_top=(vs_base=base+6)+8;
Lformat();
return;
}
/* function definition for TYPECASE-ERROR-STRINGS */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
check_arg(1);
vs_top=sup;
TTL:;
if(!(car(base[0])==VV[26])){
goto T192;}
base[1]= make_fixnum(length(cdr(base[0])));
{object V32= base[1];
if(!eql(V32,VV[43]))goto T194;
base[2]= VV[44];
vs_top=(vs_base=base+2)+1;
return;
T194:;
if(!eql(V32,VV[45]))goto T195;
base[2]= make_cons(cadr(base[0]),Cnil);
base[3]= list(2,VV[46],base[2]);
vs_top=(vs_base=base+3)+1;
return;
T195:;
if(!eql(V32,VV[47]))goto T196;
base[2]= list(2,VV[48],cdr(base[0]));
vs_top=(vs_base=base+2)+1;
return;
T196:;
base[2]= make_cons(cdr(base[0]),Cnil);
base[3]= list(2,VV[49],base[2]);
vs_top=(vs_base=base+3)+1;
return;}
T192:;
if(!(car(base[0])==VV[50])){
goto T198;}
base[2]= list(2,VV[51],cdr(base[0]));
vs_top=(vs_base=base+2)+1;
return;
T198:;
if(endp(cdr(base[0]))){
goto T200;}
base[2]= VV[52];
base[3]= cdr(base[0]);
if((simple_symlispcall_no_event(VV[70],base+2,2))!=Cnil){
goto T201;}
T200:;
{object x= car(base[0]),V33= VV[53];
while(!endp(V33))
if(eql(x,car(V33->c.c_car))){
base[2]= (V33->c.c_car);
goto T207;
}else V33=V33->c.c_cdr;
base[2]= Cnil;}
T207:;
if((base[2])==Cnil){
goto T209;}
base[3]= list(2,cadr(base[2]),Cnil);
vs_top=(vs_base=base+3)+1;
return;
T209:;
base[4]= car(base[0]);
vs_top=(vs_base=base+4)+1;
L12();
vs_top=sup;
base[3]= vs_base[0];
base[4]= list(2,base[3],car(base[0]));
base[5]= list(2,VV[54],base[4]);
vs_top=(vs_base=base+5)+1;
return;
T201:;
base[3]= car(base[0]);
vs_top=(vs_base=base+3)+1;
L12();
vs_top=sup;
base[2]= vs_base[0];
base[3]= list(2,base[2],base[0]);
base[4]= list(2,VV[55],base[3]);
vs_top=(vs_base=base+4)+1;
return;
}
/* function definition for BOIN-P */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM13;
vs_reserve(VM13);
check_arg(1);
vs_top=sup;
TTL:;
base[2]= base[0];
vs_top=(vs_base=base+2)+1;
Lsymbol_name();
vs_top=sup;
base[1]= vs_base[0];
base[2]= elt(base[1],0);
{object x= base[2],V34= VV[56];
while(!endp(V34))
if(eql(x,V34->c.c_car)){
base[3]= V34;
vs_top=(vs_base=base+3)+1;
return;
}else V34=V34->c.c_cdr;
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
return;}
}